(in-package :procemu)

(defclass cpu ()
  ((registers :initform (make-array 16 :initial-element 0)
	      :documentation "An array of 16 fixnums which represent
the registers of the CPU"
	      :accessor registers)
   (code :initarg :code
	 :type vector
	 :documentation "Array of instructions")
   (instruction-pointer :initform 0
			:accessor instruction-pointer)
   (memory :initform (make-array 4096
				 :initial-element 0
				 :element-type 'number)
	   :accessor memory-bank)
   (stack :initform '()
	  :accessor stack))
  (:documentation "A CPU with state"))

(defmethod reset ((cpu cpu))
  "Reset a CPU to its original state, but with the code intact"
  (setf (registers cpu) (make-array 16 :initial-element 0))
  (setf (instruction-pointer cpu) 0))

(defmacro register (cpu index)
  "Get the register at INDEX"
  `(aref (registers ,cpu) ,index))

(defmacro memory (cpu index)
  "Get the memory item at INDEX"
  `(aref (memory-bank ,cpu) ,index))

;; A location looks like these:
;; (register  . 3)			; A register
;; (memory . 42)			; A memory address
;; 666					; A number

(defun location-string (location)
  (if (consp location)
      (destructuring-bind (type . locator) location
	(case type
	  (register (format nil "R~D" locator))
	  (memory (format nil "(MEMORY ~D)" locator))))
      (format nil "~D" location)))

(defun location (cpu location)
  "Get the contents of a location on a cpu"
  (if (consp location)
      (destructuring-bind (type . locator) location
	(case type
	  (register (register cpu locator))
	  (memory (memory cpu locator))))
      location))

(defun (setf location) (value cpu location)
  (if (consp location)
      (destructuring-bind (type . locator) location
	(case type
	  (register (setf (register cpu locator) value))
	  (memory (setf (memory cpu locator) value))))
      (error "Cannot change the value of ~S" location)))

(defmethod run ((cpu cpu) program)
  (with-slots (code instruction-pointer) cpu
    (setf code program)
    (loop while (< instruction-pointer (length code))
	  do (perform (elt code instruction-pointer)
		      cpu))))